Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/sorting/sortcoll/sortcoll.frm

Visual Basic Form | 1995-12-30 | 8.9 KB | 253 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "SortedCollection Demo"
   ClientHeight    =   5820
   ClientLeft      =   420
   ClientTop       =   1740
   ClientWidth     =   9720
   Height          =   6540
   Icon            =   "SORTCOLL.frx":0000
   Left            =   345
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   5820
   ScaleWidth      =   9720
   Top             =   1095
   Width           =   9870
   Begin VB.Frame fraErrorAction
      Caption         =   "ErrorAction property"
      Height          =   1425
      Left            =   180
      TabIndex        =   7
      Top             =   4290
      Width           =   2685
      Begin VB.OptionButton optErrorAction
         Caption         =   "Replace Item"
         Height          =   195
         Index           =   3
         Left            =   150
         TabIndex        =   11
         Top             =   1080
         Width           =   2085
      End
      Begin VB.OptionButton optErrorAction
         Caption         =   "Ignore Request"
         Height          =   195
         Index           =   2
         Left            =   150
         TabIndex        =   10
         Top             =   810
         Width           =   2085
      End
      Begin VB.OptionButton optErrorAction
         Caption         =   "Inform User"
         Height          =   195
         Index           =   1
         Left            =   150
         TabIndex        =   9
         Top             =   540
         Value           =   -1  'True
         Width           =   2085
      End
      Begin VB.OptionButton optErrorAction
         Caption         =   "Raise Error"
         Height          =   195
         Index           =   0
         Left            =   150
         TabIndex        =   8
         Top             =   270
         Width           =   2085
      End
   End
   Begin VB.ListBox List1
      Height          =   2985
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   1
      Top             =   480
      Width           =   3195
   End
   Begin VB.CommandButton Command1
      Caption         =   "Add another image"
      Height          =   555
      Left            =   180
      TabIndex        =   0
      Top             =   3630
      Width           =   2055
   End
   Begin VB.Label Label3
      Caption         =   "SortedCollection Keys:"
      Height          =   285
      Left            =   120
      TabIndex        =   6
      Top             =   150
      Width           =   1875
   End
   Begin MSComDlg.CommonDialog cdlgOpen
      Left            =   2550
      Top             =   3630
      _version        =   65536
      _extentx        =   847
      _extenty        =   847
      _stockprops     =   0
      cancelerror     =   -1  'True
      defaultext      =   "bmp"
      dialogtitle     =   "Open"
      filename        =   "*.bmp;*.cur;*.ico;*.wmf"
      filter          =   "Images (.bmp .ico .cur .wmf)|*.bmp;*.ico;*.wmf;*.cur"
   End
   Begin VB.Label lblFileName
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   4290
      TabIndex        =   5
      Top             =   1080
      Width           =   45
   End
   Begin VB.Label Label2
      Alignment       =   1  'Right Justify
      Caption         =   "FileName:"
      Height          =   285
      Left            =   3420
      TabIndex        =   4
      Top             =   1080
      Width           =   825
   End
   Begin VB.Label lblSize
      Height          =   285
      Left            =   4320
      TabIndex        =   3
      Top             =   690
      Width           =   1515
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Size:"
      Height          =   285
      Left            =   3420
      TabIndex        =   2
      Top             =   690
      Width           =   825
   End
   Begin VB.Image imgImage
      Height          =   2025
      Left            =   3450
      Top             =   1470
      Width           =   2505
   End
   Begin VB.Menu mnuFile
      Caption         =   "File"
      Begin VB.Menu mnuFileAbout
         Caption         =   "About"
      End
      Begin VB.Menu dash
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "Exit"
      End
   End
   Begin VB.Menu mnuPopup
      Caption         =   "Popup"
      Visible         =   0   'False
      Begin VB.Menu mnuRemove
         Caption         =   "Remove Selected Items"
      End
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim sortcollImages As New SortedCollection
Private Sub Command1_Click()
On Local Error Resume Next
Dim NewImage As VImage
Dim FullFileNameKey As String
Dim Counter As Integer
   cdlgOpen.ShowOpen
   If Err.Number = 0 Then   'Most likely cancel was selected if this is false
      FullFileNameKey = cdlgOpen.FileName
      'We're going to use this full file name as our key

      'Instantiate a new VImage
      Set NewImage = New VImage

      'Load up the contents of the new object
      NewImage.Size = FileLen(FullFileNameKey)
      NewImage.FileName = FullFileNameKey             'This property extracts the 8.3 filename
      Set NewImage.Image = LoadPicture(FullFileNameKey)      'Counter'm surprised that LoadPicture works!

      'Now we can add the new object to the SortedCollection
      'Remember that you *MUST* supply a key of some sort to the Add method
      sortcollImages.Add NewImage, FullFileNameKey

      'To demonstrate a point more than anything, here we recreate the entire list box contents
      'based solely upon the SortedCollection indexes.  Note that the .Sorted property of this list
      'box is set to False.
      List1.Clear
      For Counter = 1 To sortcollImages.Count
         List1.AddItem LCase(sortcollImages.Key(Counter))
      Next Counter
      '
      'Note that this could have been achieved using a single line of code:
      '    List1.AddItem LCase(FullFileNameKey), sortcollImages.IndexOf(FullFileNameKey) - 1

      'Clean up
      Set NewImage = Nothing

      List1.ListIndex = sortcollImages.IndexOf(FullFileNameKey) - 1
      List1_Click
      'This will display the new item, since it will fire the List1_Click event

   End If     '(Error = 0)

End Sub
Private Sub Form_Load()
   sortcollImages.ErrorAction = 1       'Merely inform user
End Sub
Private Sub List1_Click()
   'Go ahead and try this with a generic Collection!! Ha Ha.
   With sortcollImages.Item(List1.ListIndex + 1)
      lblSize = .Size
      lblFileName = .FileName
      imgImage.Picture = .Image
   End With
End Sub
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If List1.ListIndex > -1 And Button = vbRightButton Then PopupMenu mnuPopup
End Sub
Private Sub mnuExit_Click()
   Unload Me
End Sub
Private Sub mnuFileAbout_Click()
Dim msg As String
msg = "This example demonstrates the flexibility of the SortedCollection class. When you use the Add method " & _
   "to add a new member to a SortedCollection (in this case, a simple VImage object), the member is stored in place " & _
   "according to its key value (in this case, the full file name).  If the key value is not unique, then an attempted Add will cause " & _
   "the private procedure HandleDuplicateIndex to fire, and your application response to the duplicate index value can be " & _
   "controlled programmatically by setting the .ErrorAction property of the SortedCollection object. " & vbCrLf & vbCrLf
msg = msg & "SortedCollection supports the standard collection methods: Item(), Count, Remove() and Clear.  It adds " & _
   "the following new methods: Key(), KeyMixedCase(), IndexOf(), and KeyInUse()." & vbCrLf & vbCrLf & _
   "Please see the source code for details concerning the Key(), IndexOf() and KeyInUse() methods of the SortedCollection class. " & _
   vbCrLf & vbCrLf & "Comments, suggestions, questions and improvements should be forwarded to: " & vbCrLf & _
   "Chris Vel
zquez, [e-mail]"
   MsgBox msg, vbInformation
End Sub
Private Sub mnuRemove_Click()
Dim Counter As Integer
Dim ListMax As Integer
   ListMax = List1.ListCount
   For Counter = ListMax - 1 To 0 Step -1
      If List1.Selected(Counter) Then
         sortcollImages.Remove Counter + 1
         List1.RemoveItem Counter
      End If
   Next Counter
   If List1.ListCount > 0 Then List1.ListIndex = 0
End Sub
Private Sub optErrorAction_Click(Index As Integer)
   'Change this to view the possible behaviors.
   sortcollImages.ErrorAction = Index
End Sub